'------------------------------------------------------------------------------------------- 
'    QCalendar Control by Pasquale P.C.B.        4-2001 
'    Dedicated to my beautiful wife Ana  
'------------------------------------------------------------------------------------------- 
$typecheck off
$include "includes\apidate.inc"
TYPE qcalendar EXTENDS Qpanel
    PUBLIC:
    M AS INTEGER
    Y AS INTEGER
    D AS INTEGER
    week1% AS INTEGER '------------------------------------------<<<<<<<<<<<<<<<<<<' 
    PopupMenu AS QPopupMenu
    mesi(1 to 12) AS QmenuItem


    Grid AS QSTRINGGRID
    
    Panel1 AS QPANEL
        BTNprev AS QCOOLBTN
        btnnext AS QCOOLBTN
        bntupy AS QcooLBTN
        bntdowny AS QCOOLBTN
    Panel2 AS QPANEL
'-- ************************************************************************************' 
    SUB LoadCal(datum$ as string) 
	$typecheck off
        nowd$=field$(datum$,"-",2) 

        qcalendar.d=val(nowd$)
        nowm$=field$(datum$,"-",1) 
        qcalendar.m=val(nowm$)
        nowy$=field$(datum$,"-",3)
        qcalendar.y=val(nowy$)
'        qcalendar.panel1.caption=qcalendar.mesi(val(nowm$)).caption
	qcalendar.panel1.caption=nowm$
        qcalendar.panel1.caption=qcalendar.panel1.caption+"-"+nowy$
        qcalendar.week1%=weekday(nowm$+"-"+"01"+"-"+nowy$)

        if qcalendar.week1%=1 then qcalendar.week1%=8
        dim v as integer
        
        if qcalendar.m=1 then
            lastd%=val(field$(lastdaym("12-1-"+str$(qcalendar.y-1)),"-",2)) 
        else
            lastd%=val(field$(lastdaym(str$(qcalendar.m-1)+"-1-"+str$(qcalendar.y)),"-",2))
        end if
        v=0

        for i=qcalendar.week1%-2 to 0 step -1
            qcalendar.grid.cell(i,1)=str$(lastd%-v)
 
            v++
        next
        
        lb%=val(field$(lastdaym(datum$),"-",2))
        ri=1:co=0
        if qcalendar.week1%=8 then
            ri=2:co=0
        else
            co=qcalendar.week1%-1
        end if
        i=0

        do      
            for c=co to 6
                i++
                qcalendar.grid.cell(c,ri)=str$(i)
                if i=lb% then exit do
            next
            ri++
            co=0
        loop until i=lb%
        
        i=1
        if c=6 then
            ri++:co=0
        else
            co=c+1
        end if
        do

            for c=co to 6
                qcalendar.grid.cell(c,ri)=str$(i)  
                i++
            next
        
            co=0:ri++
        loop until ri=8

        ri=int((val(nowd$)+qcalendar.week1%-2)/7)+1  
        
        co=weekday(nowm$+"-"+nowd$+"-"+nowy$)-2     '!!!    1  cause error !!! 

        'qcalendar.grid.row=ri:
        'qcalendar.grid.col=co             
 $typecheck on
    END SUB
'-- ************************************************************************************' 
    SUB mnuclick(s as QmenuItem)
      qcalendar.loadcal(str$(s.menuindex+1)+"-"+str$(qcalendar.d)+"-"+str$(qcalendar.y))        
    END SUB 
'-- ************************************************************************************' 
    SUB INIT(inidatum$)
	$typecheck off
        Dim pBuffer As String , ST As SYSTEMTIME
        if inidatum$<>"" then
            st.wYear=val(field$(inidatum$,"-",3))
            st.wmonth=val(field$(inidatum$,"-",1))
            st.wDay =val(field$(inidatum$,"-",2))
            pbuffer="Init"
            pBuffer = String$(255, 0)
            r=GetDateFormat( ByVal 0&, 0, st, "ddd", Varptr(pBuffer), Len(pBuffer))
            pBuffer = Left$(pBuffer, InStr(1, pBuffer, Chr$(0)) - 1)
            if len(pbuffer)=0 then
                 showmessage inidatum$+" it's not valid. Format must be 'MM-DD-YYYYY' ie. '04-23-2001' and the date must be exist"
                 qcalendar.visible=0
                 exit sub
            end if
        end if
        dim b as string
        b=string$(4,0)  
        getlocaleinfo(ByVal 0&, 5  ,varptr(b),len(b))
        dim todayC as string
        select case val(b)
            case 386
                todayC="Danes"
            case 39
                todayC="Oggi"
            case 33
                todayC="Aujourd'hui"
            case 55,52,34
                todayC="Hoy"
            case 49
                todayC="Heute"
            case else
                todayC="Today"
        end select
        for i = 1 to 12
             b=string$(10,0)  
             getlocaleinfo(ByVal 0&, i+55,varptr(b),len(b))
             qcalendar.mesi(i).OnClick=qcalendar.mnuClick
             qcalendar.mesi(i).Caption = b 
             qcalendar.PopupMenu.AddItems qcalendar.mesi(i)
        next
        qcalendar.panel1.popupmenu=qcalendar.popupmenu
        dim week(1 to 7)as string
        for i=1 to 7
            b=string$(3,0)  
            getlocaleinfo(ByVal 0&, i+48  ,varptr(b),len(b))    
            week(i)=b
        next
        for i=1 to qcalendar.grid.colcount+1
            qcalendar.grid.cell(i-1,0)=week(i)
        next
        ST.wDay = val(field$(date$,"-",2))
        ST.wMonth = val(field$(date$,"-",1))
        ST.wYear = val(field$(date$,"-",3))
        b=string$(15,0)  
        getlocaleinfo(ByVal 0&, &H20,varptr(b),len(b))
        pBuffer = String$(255, 0)
        GetDateFormat( ByVal 0&, 0, ST, b, Varptr(pBuffer), Len(pBuffer))
        pBuffer = Left$(pBuffer, InStr(1, pBuffer, Chr$(0)) - 1)        
        qcalendar.grid.deloptions 4
        if inidatum$="" then
            qcalendar.loadcal(date$)
        else
            qcalendar.loadcal(inidatum$)
        end if
	$typecheck on
    END SUB

'-- ************************************************************************************' 
    EVENT grid.onselectcell (Col%, Row%, CanSelect%,s as qstringgrid)
	$typecheck off
       qcalendar.d=val(s.cell(col%,row%))
       if row%=1 then
           if col%<qcalendar.week1%-1 then
               canselect%=0         
               exit sub
           end if
       end if
       if row%>4 then
            if val(s.cell(col%,row%))<22 then
                canselect%=0
                exit sub
            end if
       end if
       Dim pBuffer As String, ST As SYSTEMTIME
       ST.wDay =qcalendar.d
       ST.wMonth = qcalendar.m
       ST.wYear = qcalendar.y
       dim b as string
       b=string$(15,0)  
       getlocaleinfo(ByVal 0&, &H20,varptr(b),len(b))
       pBuffer = String$(255, 0)
       GetDateFormat( ByVal 0&, 0, ST, b, Varptr(pBuffer), Len(pBuffer))
       pBuffer = Left$(pBuffer, InStr(1, pBuffer, Chr$(0)) - 1)        
       qcalendar.panel2.caption=pBuffer
	$typecheck on
    END EVENT
'-- ************************************************************************************' 
    EVENT bntupy.onclick
	$typecheck off
        qcalendar.y=qcalendar.y+1
        if val(field$(lastdaym(str$(qcalendar.m)+"-01-"+str$(qcalendar.y)),"-",2))<qcalendar.d then 
            qcalendar.loadcal(lastdaym(str$(qcalendar.m)+"-01-"+str$(qcalendar.y)))
        else
            qcalendar.loadcal(str$(qcalendar.m)+"-"+str$(qcalendar.d)+"-"+str$(qcalendar.y))
        end if    
Dim pBuffer As String, ST As SYSTEMTIME
       ST.wDay =qcalendar.d
       ST.wMonth = qcalendar.m
       ST.wYear = qcalendar.y
       dim b as string
       b=string$(15,0)  
       getlocaleinfo(ByVal 0&, &H20,varptr(b),len(b))
       pBuffer = String$(255, 0)
       GetDateFormat( ByVal 0&, 0, ST, b, Varptr(pBuffer), Len(pBuffer))
       pBuffer = Left$(pBuffer, InStr(1, pBuffer, Chr$(0)) - 1)        
       qcalendar.panel2.caption=pBuffer
	$typecheck on
    END EVENT
'-- ************************************************************************************' 
    EVENT  btnnext.onclick(s as qcoolbtn)
	$typecheck off
        if qcalendar.m=12 then
            qcalendar.m=1:qcalendar.y=qcalendar.y+1
        else
            qcalendar.m=qcalendar.m+1
        end if
        if val(field$(lastdaym(str$(qcalendar.m)+"-01-"+str$(qcalendar.y)),"-",2))<qcalendar.d then 
            qcalendar.loadcal(lastdaym(str$(qcalendar.m)+"-01-"+str$(qcalendar.y)))
        else
            qcalendar.loadcal(str$(qcalendar.m)+"-"+str$(qcalendar.d)+"-"+str$(qcalendar.y))
        end if
Dim pBuffer As String, ST As SYSTEMTIME
       ST.wDay =qcalendar.d
       ST.wMonth = qcalendar.m
       ST.wYear = qcalendar.y
       dim b as string
       b=string$(15,0)  
       getlocaleinfo(ByVal 0&, &H20,varptr(b),len(b))
       pBuffer = String$(255, 0)
       GetDateFormat( ByVal 0&, 0, ST, b, Varptr(pBuffer), Len(pBuffer))
       pBuffer = Left$(pBuffer, InStr(1, pBuffer, Chr$(0)) - 1)        
       qcalendar.panel2.caption=pBuffer
	$typecheck on
    END EVENT
'-- ************************************************************************************' 
    EVENT bntdowny.onclick
	$typecheck off
        if qcalendar.y>1753 then
            qcalendar.y=qcalendar.y-1
        else 
            exit sub
        end if    
        if val(field$(lastdaym(str$(qcalendar.m)+"-01-"+str$(qcalendar.y)),"-",2))<qcalendar.d then
            qcalendar.loadcal(lastdaym(str$(qcalendar.m)+"-01-"+str$(qcalendar.y)))
            exit sub
        else
            qcalendar.loadcal(str$(qcalendar.m)+"-"+str$(qcalendar.d)+"-"+str$(qcalendar.y))
        end if   
Dim pBuffer As String, ST As SYSTEMTIME
       ST.wDay =qcalendar.d
       ST.wMonth = qcalendar.m
       ST.wYear = qcalendar.y
       dim b as string
       b=string$(15,0)  
       getlocaleinfo(ByVal 0&, &H20,varptr(b),len(b))
       pBuffer = String$(255, 0)
       GetDateFormat( ByVal 0&, 0, ST, b, Varptr(pBuffer), Len(pBuffer))
       pBuffer = Left$(pBuffer, InStr(1, pBuffer, Chr$(0)) - 1)        
       qcalendar.panel2.caption=pBuffer
	$typecheck on
    END EVENT          
'-- ************************************************************************************' 
    EVENT btnprev.onclick(s as qcoolbtn)
	$typecheck off
        if qcalendar.m=1 then
            if qcalendar.y=1753 then exit sub
            qcalendar.m=12:qcalendar.y=qcalendar.y-1
        else
            qcalendar.m=qcalendar.m-1
        end if
        if val(field$(lastdaym(str$(qcalendar.m)+"-01-"+str$(qcalendar.y)),"-",2))<qcalendar.d then
            qcalendar.loadcal(lastdaym(str$(qcalendar.m)+"-01-"+str$(qcalendar.y)))
            exit sub
        else
            qcalendar.loadcal(str$(qcalendar.m)+"-"+str$(qcalendar.d)+"-"+str$(qcalendar.y))
        end if
Dim pBuffer As String, ST As SYSTEMTIME
       ST.wDay =qcalendar.d
       ST.wMonth = qcalendar.m
       ST.wYear = qcalendar.y
       dim b as string
       b=string$(15,0)  
       getlocaleinfo(ByVal 0&, &H20,varptr(b),len(b))
       pBuffer = String$(255, 0)
       GetDateFormat( ByVal 0&, 0, ST, b, Varptr(pBuffer), Len(pBuffer))
       pBuffer = Left$(pBuffer, InStr(1, pBuffer, Chr$(0)) - 1)        
       qcalendar.panel2.caption=pBuffer
	$typecheck on
    END EVENT
'-- ************************************************************************************' 
    EVENT grid.onDrawcell (Col% AS LONG, Row% AS LONG, State AS LONG, R AS QRECT, S AS QSTRINGGRID)
	$typecheck off
        w=((s.colwidths(col%)-s.textwidth(s.cell(col%,row%)))\2)-1
        s.fillrect(r.left,r.top,r.right,r.bottom,-2147483643)  
        if row%=1 then
            if col%<qcalendar.week1%-1 then
                s.textout(r.left+w,r.top+1,s.cell(col%,row%),-2147483631,-1)
                exit sub
            end if
        end if    
        if row%>4 then
            if val(s.cell(col%,row%))<22 then
                s.textout(r.left+w,r.top+1,s.cell(col%,row%),-2147483631,-1)
                exit sub
            end if
        end if   
        if state=1 then
            s.circle(r.left,r.top,r.right,r.bottom,9437183,9437183)
        end if
        if format$("%.2d-%.2d-%d",qcalendar.m,val(s.cell(col%,row%)),qcalendar.y)=date$ then
            s.circle(r.left,r.top,r.right,r.bottom,8716543,-1)
            s.circle(r.left+1,r.top+1,r.right-1,r.bottom-1,8716543,-1)        
        end if
        if col%=6 then 
            s.textout(r.left+w,r.top+1,s.cell(col%,row%),5732096,-1)
        else
            s.textout(r.left+w,r.top+1,s.cell(col%,row%),-2147483640,-1)
        end if
	$typecheck on
    END EVENT
'-- ************************************************************************************' 
    FUNCTION QDate$ as string
       result=str$(qcalendar.m)+"-"+str$(qcalendar.d)+"-"+str$(qcalendar.y)
    END FUNCTION 
'-- ************************************************************************************' 
    CONSTRUCTOR
        Caption = "Calendar"
        Width = 179
        Height = 183
        BevelInner = 1
        'BevelOuter = 1 
            panel2.parent=qcalendar
            panel2.Left = 0
            panel2.Top = 146
            panel2.Caption = "QCalendar by P.C.B."
            panel2.Width = 173
            panel2.Height = 25
            panel2.BevelInner = 1
            'BevelOuter = 1 
            panel2.Align = 1
            panel2.TabOrder = 2    
                bntdowny.parent=qcalendar.panel1
                'BMP = "C:\RapidQ\cdx.bmp" 
                bntdowny.caption="6"
                bntdowny.font.name="Webdings"            
                bntdowny.Left = 25
                bntdowny.Top = 1
                bntdowny.Width = 15
                bntdowny.Height = 21
                bntdowny.Flat = 1
                bntdowny.font.color=-2147483639  
                bntdowny.Align = 3
               'BMP = "C:\RapidQ\cdx.bmp" 
                bntupy.parent=qcalendar.panel1
                bntupy.caption="5"
                bntupy.font.name="Webdings"            
                bntupy.Left = 100
                bntupy.Top = 1
                bntupy.Width = 15
                bntupy.Height = 13
                bntupy.Flat = 1
                bntupy.font.color=-2147483639  
                bntupy.Align = 4
                btnnext.parent=qcalendar.panel1
                'BMP = "C:\RapidQ\cdx.bmp" 
                btnnext.caption="è"
                btnnext.font.name="Wingdings"            
                btnnext.Left = 148
                btnnext.Top = 1
                btnnext.Width = 23
                btnnext.Height = 21
                btnnext.Flat = 1
                btnnext.font.color=-2147483639  
                btnnext.Align = 4
                'btnnext.onclick=btnnextc             
                BTNprev.parent=qcalendar.panel1
                'BMP = "C:\RapidQ\csx.bmp" 
                BTNprev.caption="ç"
                BTNprev.font.name="Wingdings"
                BTNprev.Left = 2
                BTNprev.Top = 1
                BTNprev.Width = 23
                BTNprev.Height = 21
                BTNprev.Flat = 1
                btnprev.font.color=-2147483639  
                BTNprev.Align = 3
                'BTNprev.onclick=btnprevc 
            Panel1.parent=qcalendar
            Panel1.Left = 0
            Panel1.Top = 0
            Panel1.Caption = "Panel1"
            Panel1.Width = 173
            Panel1.Height = 29
            Panel1.bevelinner=1
            Panel1.Align = 1
            Panel1.TabOrder = 1
            Panel1.font.addstyles 0
            Panel1.color=-2147483646
            Panel1.font.color=-2147483639            
            grid.parent=qcalendar
            grid.borderstyle=0
            grid.Left = 0
            grid.Top = 25
            grid.Height = 106
            grid.Width = 173
            grid.Align = 1
            grid.ScrollBars = 0
            grid.GridLineWidth = 0
            grid.ColCount =7'' 8 '-- was 7 - and error occures 
            grid.RowCount =7'' 8 '-- was 7 - and error occures 
            grid.Col = 0
            grid.DefaultColWidth = 25
            grid.DefaultRowHeight = 15
            grid.FixedCols = 0
    END CONSTRUCTOR    
END TYPE
$typecheck on
